home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 5 / Skunkware 5.iso / src / Tools / lsof_3.37 / scripts / list_NULf.perl5 < prev    next >
Encoding:
Text File  |  1995-07-31  |  4.5 KB  |  150 lines
  1. #!/usr/local/bin/perl5
  2. #
  3. # $Id: list_NULf.perl5,v 1.3 95/06/30 08:55:51 abe Exp $
  4. #
  5. # list_NULf.perl5 -- sample Perl 5 script to list lsof 3.33 and above NUL-
  6. #             terminated full field output (i.e., -F0 output)
  7. #
  8. # This script has been tested under perl version 5.001e.
  9. #
  10. # Copyright 1994 Purdue Research Foundation, West Lafayette, Indiana
  11. # 47907.  All rights reserved.
  12. #
  13. # Written by Victor A. Abell
  14. #
  15. # This software is not subject to any license of the American Telephone
  16. # and Telegraph Company or the Regents of the University of California.
  17. #
  18. # Permission is granted to anyone to use this software for any purpose on
  19. # any computer system, and to alter it and redistribute it freely, subject
  20. # to the following restrictions:
  21. #
  22. # 1. Neither the authors nor Purdue University are responsible for any
  23. #    consequences of the use of this software.
  24. #
  25. # 2. The origin of this software must not be misrepresented, either by
  26. #    explicit claim or by omission.  Credit to the authors and Purdue
  27. #    University must appear in documentation and sources.
  28. #
  29. # 3. Altered versions must be plainly marked as such, and must not be
  30. #    misrepresented as being the original software.
  31. #
  32. # 4. This notice may not be removed or altered.
  33.  
  34. # Initialize variables.
  35.  
  36. $fhdr = 0;                            # fd hdr. flag
  37. $fdst = 0;                            # fd state
  38. $access = $devch = $devn = $fd = $inode = $lock = "";        # | file descr.
  39. $name = $offset = $proto = $size = $stream = $type = "";    # | variables
  40. $pidst = 0;                            # process state
  41. $cmd = $login = $pgrp = $pid = $uid = "";            # process var.
  42.  
  43. # Process the ``lsof -F'' output a line at a time, gathering
  44. # the variables for a process together before printing them;
  45. # then gathering the variables for each file descriptor
  46. # together before printing them.
  47.  
  48. while (<>) {
  49.     chop;
  50.     @F = split('\0', $_, 999);
  51.     if ($F[0] =~ /^p/) {
  52.  
  53. # A process set begins with a PID field whose ID character is `p'.
  54.  
  55.     if ($pidst) { &list_proc }
  56.     if ($fdst) { &list_fd; $fdst = 0; }
  57.     foreach $i (0 .. ($#F - 1)) {
  58.  
  59.         PROC: {
  60.         if ($F[$i] =~ /^c(.*)/) { $cmd = $1; last PROC }
  61.         if ($F[$i] =~ /^g(.*)/) { $pgrp = $1; last PROC }
  62.         if ($F[$i] =~ /^p(.*)/) { $pid = $1; last PROC }
  63.         if ($F[$i] =~ /^u(.*)/) { $uid = $1; last PROC }
  64.         if ($F[$i] =~ /^L(.*)/) { $login = $1; last PROC }
  65.         print "ERROR: unrecognized process field: \"$F[$i]\"\n";
  66.         }
  67.     }
  68.     $pidst = 1;
  69.     next;
  70.     }
  71.  
  72. # A file descriptor set begins with a file descriptor field whose ID
  73. # character is `f'.
  74.  
  75.     if ($F[0] =~ /^f/) {
  76.     if ($pidst) { &list_proc }
  77.     if ($fdst) { &list_fd }
  78.     foreach $i (0 .. ($#F - 1)) {
  79.  
  80.         FD: {
  81.         if ($F[$i] =~ /^a(.*)/) { $access = $1; last FD; }
  82.         if ($F[$i] =~ /^f(.*)/) { $fd = $1; last FD; }
  83.         if ($F[$i] =~ /^l(.*)/) { $lock = $1; last FD; }
  84.         if ($F[$i] =~ /^t(.*)/) { $type = $1; last FD; }
  85.         if ($F[$i] =~ /^d(.*)/) { $devch = $1; last FD; }
  86.         if ($F[$i] =~ /^D(.*)/) { $devn = $1; last FD; }
  87.         if ($F[$i] =~ /^s(.*)/) { $size = $1; last FD; }
  88.         if ($F[$i] =~ /^o(.*)/) { $offset = $1; last FD; }
  89.         if ($F[$i] =~ /^i(.*)/) { $inode = $1; last FD; }
  90.         if ($F[$i] =~ /^P(.*)/) { $proto = $1; last FD; }
  91.         if ($F[$i] =~ /^S(.*)/) { $stream = $1; last FD; }
  92.         if ($F[$i] =~ /^n(.*)/) { $name = $1; last FD; }
  93.         print "ERROR: unrecognized file set field: \"$F[$i]\"\n";
  94.         }
  95.     }
  96.     $fdst = 1;
  97.     next;
  98.     }
  99.     print "ERROR: unrecognized: \"$_\"\n";
  100. }
  101.  
  102. # Flush any stored file or process output.
  103.  
  104. if ($fdst) { &list_fd }
  105. if ($pidst) { &list_proc }
  106. exit(0);
  107.  
  108.  
  109. ## list_fd -- list file descriptor information
  110. #          Values are stored inelegantly in global variables.
  111.  
  112. sub list_fd {
  113.     if ( ! $fhdr) {
  114.  
  115.     # Print header once.
  116.  
  117.     print "      FD   TYPE      DEVICE   SIZE/OFF      INODE  NAME\n";
  118.     $fhdr = 1;
  119.     }
  120.     printf "    %4s%1.1s%1.1s %4.4s", $fd, $access, $lock, $type;
  121.     $tmp = $devn; if ($devch ne "") { $tmp = $devch }
  122.     printf "  %10.10s", $tmp;
  123.     $tmp = $size; if ($offset ne "") { $tmp = $offset }
  124.     printf " %10.10s", $tmp;
  125.     $tmp = $inode; if ($proto ne "") { $tmp = $proto }
  126.     printf " %10.10s", $tmp;
  127.     $tmp = $stream; if ($name ne "") { $tmp = $name }
  128.     print "  ", $tmp, "\n";
  129.  
  130. # Clear variables.
  131.  
  132.     $access = $devch = $devn = $fd = $inode = $lock = "";
  133.     $name = $offset = $proto = $size = $stream = $type = "";
  134. }
  135.  
  136.  
  137. # list_proc -- list process information
  138. #           Values are stored inelegantly in global variables.
  139.  
  140. sub list_proc {
  141.     print "COMMAND       PID    PGRP  USER\n";
  142.     $tmp = $uid; if ($login ne "") {$tmp = $login }
  143.     printf "%-9.9s  %6d  %6d  %s\n", $cmd, $pid, $pgrp, $tmp;
  144.  
  145. # Clear variables.
  146.  
  147.     $cmd = $login = $pgrp = $pid = $uid = "";
  148.     $fhdr = $pidst = 0;
  149. }
  150.